00100	C***** AIDS IN EXTRACTING PARTS FROM SCORES AND DOES AUTOMATIC PAGE LAYOUT. 
00200	C***************************** THERE ARE STILL SEVERAL BUGS IN THIS PROG.
00300	C***************************** TRANSPOSE-ONLY IS NOT FULLY TESTED.
00400	C*********** TRANSPOSITION OF 'F' PARTS IN BASS CLEF HAS SOME PROBLEMS.
00500	C***************************** ETC., ETC.    8/78
00600	
00700	C SEE PAGE.CMD FOR LOADING INSTRUCTIONS
00800	C **** SUBROUTINE LIST *****
00900	C PAGE:  READX
01000	C RESPC:
01100	C RESTP:
01200	C WRTPAG: 
01300	C PGSUB: FILOUT(NAMQ,NPG), FILEIN, STAVES
01400	C TRONLY: 
01500	C TRNSP: TRNSP, RVRS
01600	C PTMOVX: PTMOVE, TURN
01700	C FNDTRN: MNMX, FNDTRN, BRJUGL, GET
01800	C PFAIL: LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX,RLOOP,BLTEM,IFIX,FLOAT
01900	C	 GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0,PSHFT,ADRST,STAFF
02000	C        RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM,SLRV,CLEFN,MMNN,CODEN,ZERO 
02100	C EXT:   PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
02200	
02300		COMMON/STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,JPQ
02400		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
02500		1 RCLEF(0/7) /RSIG/RSIG(0/7) /IVV/NRD(200)
02600		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
02700	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
02800		COMMON/XRN/RN(3500) /SF/KL,RT,KP,STFSZ,NAMX,EXT
02900		1 /PTR/KWDS(350)/LLL/LLL,LL,I,IX,XSIG/XXX/LK,LP,JY /JN/J,N
03000	C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
03100	      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/7),KSAVE(30),
03200		1 RMETER(0/7),RCL(0/7),NUMS(30),PGTRN(500),SAVES(470),U(1)
03300	C KSAVE AND SAVES ARE TO SAVE REHEARSAL NUMS, ETC. -- LIMIT=30
03400		COMMON /PX/KPN(450) /Q/Q(4000) /KBAR/KBAR(1027) /IRST/IRST
03500	 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
03600		1 /RSP/KNM(100) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
03700		1 /JWDS/JWDS(300),RRN(3000)
03800	C  JWDS IS EQUIVALENCED IN PTMOVX.F4 AND RESTP.F4
03900		DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.0/
04000		1 ,RLTRSZ/1.0/,SPCPG/2.7/
04100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
04200		1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(JRSTF,RSTJ2)
04300		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
04400		1,(STFNM,KBAR(508)),(NUM1,NUMS,KPN),(PGTRN(1),KBAR(5 16))
04500		1,(SAVES,Q(3001)),(KSAVE,Q(3475)),(U,KBAR(1026))
04600	C  HANDLES 503 PAGES AND PAGE-TURN INFO. IN KBAR AND PGTRN
04700	C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)
04800	
04900		RN(2)=0
05000		EXT='MS'
05100		IRST=0
05200	C IRST IS USED IN SUBROUTINE RESTP
05300		IPG=0
05400		KBR=0
05500		NMPG='PAGEA'
05600		JPG=0
05700		JRD=1
05800		ENDLN=0
05900		SAVSIZ=0
06000		ISN=0
06100		NCNT=10000
06200		IFOUND=0
06300	
06400		TYPE 1000   
06500		ACCEPT 2000,NAMX
06600		IF(NAMX.EQ.0)CALL PT2
06700		IF(NAMX.EQ.3)CALL TRONLY
06800		NPG=NAMX-2
06900		TYPE 3300
07000		IF(NPG.GE.0)GO TO 3000
07100	CC	IF(NPG.GE.0)TYPE 3
07200		ACCEPT 2,KS,NTYPE
07300	C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
07400	CC	NAMZ=KS
07500		JNM=1
07600	
07700		CALL LO2UP(KS)
07800	143	CALL IFILE(1,KS)
07900		READ(1,2)K
08000	CC843	READ(1,2)K
08100		IF(K.NE.'COMME')GO TO 543
08200	743	READ(1,643),K,K,K
08300	C  READ ET DIRECTORY !∃∀ βλπα∀πεβα!ββX!
08400		IF(K.NE.';')GO TO 743
08500		READ(1,2)K
08600		GO TO 843
08700	C  FIRST LINE MUST BE EXTENSION NAME
08800	643	FORMAT(3A1)
08900	2	FORMAT(A5,30I)
09000	CC3	FORMAT(' TYPE FILE NAME.EXT -- '$)
09100	3300	FORMAT(' TYPE FILE NAME -- '$)
09200	1000	FORMAT(' 1=PARTS, 2=PAGE LAYOUT, 3=TRNSP ONLY, <CR>=OLD  '$)
09300	2000	FORMAT(I)
09400	CC543	READ(1,2,END=343),KNM(JNM),(KPN(K),K=1,30)
09500	543	CALL IFILE(1,KS)
09600	843	CALL READX(1,KNM(JNM),EXT,KEND,NUMS)
09700		IF(KEND)GO TO 343
09800		JNM=JNM+1
09900		DO 434 K=1,30
10000		J=KPN(K)
10100		JPG=JPG+1
10200		NRD(JPG)=J
10300	C  BE CAREFUL ABOUT RUNNING OVER NRD ARRAY (100)-- ZEROS ARE INSERTED***********
10400	434	IF(J.EQ.0)GO TO 843
10500		GO TO 843
10600	CC3000	CALL NAMEXT     
10700	3000	CALL READX(5,NAMX,EXT,KEND,NUMS)
10800		KNM(1)=NAMX
10900		GO TO 4000
11000	343	KNM(JNM)=-1
11100		NXX=NRD(1)
11200	C NXX COULD BE EQUIV. TO NRD(1)!!
11300	4000	NAMZ=KNM(1)
11400		IF(NPG.GE.0.AND.NUM1.GT.0)NCNT=NUM1
11500	C TYPE A # AFTER FILE NAME TO SET # OF FILES TO BE READ.
11600		DO 911 K=0,7
11700		RCLEF(K)=99
11800		RCL(K)=99
11900		RMETER(K)=99
12000	C  INITS STUFF FOR PAGE LAYOUT
12100		BRACK(K)=0
12200	911	RSIG(K)=99
12300		
12400	744	XSIG=FIB
12500		QSIG=FIB
12600		CLEF=-1
12700		XMTR=FIB
12800		XLFT=0
12900		JPG=0
13000		YCLEF=2.
13100		YSIG=2.
13200		YMTR=2.
13300		RSTAFF=0
13400		RM=0
13500		JNM=1
13600	CZ1344	JNM=1
13700	
13800	1344	IF(NCNT.EQ.0)GO TO 1212
13900	C NCNT IS INPUT FILE COUNTER.
14000		NCNT=NCNT-1
14100		ZLFT=.5
14200		KQ=0
14300		IF(NPG.EQ.0)JRD=0
14400		LLL=1
14500		LK=1
14600	86	FORMAT(1XA5)
14700	186	FORMAT(1XA5,'.',A3)
14800	
14900	83	NAME=KNM(JNM)
15000	CZ	JNM=JNM+1
15100		IF(NAME.EQ.-1)GO TO 1212
15200	CC	JRD=JRD+1
15300	CXCX	NXX=NRD(JRD+1)
15400	CZ	NXX=NRD(JRD)
15500	C?????????????	IF(KBR.EQ.0)GO TO 284
15600		JZ=-1
15700	10	IF(LOOKX(NAME,EXT))GO TO 284
15800	CZ100	IF(JZ)GO TO 344
15900	C  FOUND NO MORE TO READ
16000	344	NAME=NAMZ+256
16100	C UPDATE 4TH CHAR.  (E.G. AAAAA TO AAABA)
16200		NAMZ=NAME
16300		KNM(JNM)=NAME
16400		IF(LOOKX(NAME,EXT))GO TO 284 
16500	C NOW ALL DONE WITH INPUT, START OUTPUT
16600	1212	CALL PUTEXT('BARS','PAG')
16700		RSTJ2=SAVSIZ
16800		DO 1213 K=0,75
16900	1213	U(K)=RSTFAC(K)
17000	C SAVE VARIOUS THINGS ON END OF KBAR ARRAY FOR USE IN OUTPUT SECTION.
17100		CALL EXTOUT(KBAR,1100)
17200	CC	CALL EXTOUT(RSTFAC,128)
17300		CALL FINEXT
17400	C K (NUM OF BARS - UP TO 511) IS FIRST LOC OF KBAR.
17500		CALL PT2(KPN,Q,KWDS,RN)
17600	
17700	284	JZ=0
17800		SN=0
17900		IF(NPG)SN=200
18000		SNMTR=SN
18100		IF(RM.NE.0)GO TO 277
18200		RM=-1
18300	4	FORMAT(' TYPE INST NAME  '$)
18400		IF(NPG.GE.0)GO TO 277     
18500		TYPE 4
18600		ACCEPT 2,RNAM,K
18700		CALL LO2UP(RNAM)
18800		RNAM2=-1
18900		RNAM3=-1
19000		RNAM4=-1
19100		IF(K.EQ.0)GO TO 277
19200		TYPE 177
19300		ACCEPT 2,RNAM2,K
19400		CALL LO2UP(RNAM2)
19500		IF(K.EQ.0)GO TO 277
19600	C  TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
19700		TYPE 177
19800		ACCEPT 2,RNAM3
19900		CALL LO2UP(RNAM3)
20000		TYPE 177
20100		ACCEPT 2,RNAM4
20200		CALL LO2UP(RNAM4)
20300	177	FORMAT(' OTHER INST NAME   ',$)
20400	
20500	
20600	277	TYPE 186,NAME,EXT
20700	C*** 	CALL GETEXT(NAME,EXT)
20800	C*** C  LP IS START OF RN ARRAY THIS TIME
20900	C*** 	CALL EXTIN(RSTFAC,20)
21000	C*** 	CALL EXTIN(KWDS,JJ2)
21100	C*** 	CALL EXTIN(RN,JPQ)
21200		CALL INMUS(NAME,EXT,RN,KWDS,RSTFAC)
21300	C NEW SAVE FORMAT
21400		IF(JRSTF.LT.10000)RSTJ2=1.0
21500	C X!Z+*↑: WHERE IS THE BUG THAT PUTS AN INTEGER INTO RSTJ2????
21600	CZ	IF(SAVSIZ.EQ.0)SAVSIZ=RSTJ2
21700		IPG=NPG
21800	C  IPG MUST BE RESET EACH TIME BECAUSE READIN WIPES IT OUT.
21900	
22000		CALL RLOOP(Q,RN,JPQ)
22100		ITEM=JJ2-2
22200	
22300	1211	R=RN(KWDS(1)+2)
22400		K=2
22500		LS=1
22600		J=0
22700	C  SORTS NOTES AND RHYTH ONLY
22800	1111	KX=KWDS(K)
22900		RA=RN(KX+2)
23000		IF(RA.GE.R)GO TO 1011
23100		CALL EXCH(KWDS(K),KWDS(LS))
23200		J=-1
23300	1011	R=RA
23400	2611	LS=K
23500		K=K+1
23600		IF(K.LE.ITEM)GO TO 1111
23700		IF(J)GO TO 1211
23800	C NOW ALL SORTED  (BY  STAFF)
23900		J=1
24000		KW=1
24100	
24200		DO 1311 K=1,ITEM
24300		LS=KWDS(K)
24400		IF(RN(LS+1).GT.2)GO TO 2711
24500		RN(LS+3)=RN(LS+3)-.001
24600	C  MOVE ALL NOTES AND RESTS SLIGHTLY TO LEFT. (FOR SORTER)
24700	2711	M=RN(LS)+3
24800		CALL RLOOP(Q(J),RN(LS),M)
24900		J=J+M
25000		KPN(K)=KW
25100	1311	KW=KW+M  
25200	
25300		KPN(ITEM+1)=KW
25400	CC	DO 1511 K=1,ITEM+1
25500	CC1511	KWDS(K)=KPN(K)
25600	CC	DO 1611 K=1,JPQ
25700	CC1611	RN(K)=Q(K)
25800		CALL BLTEM
25900	C  BLTEM BLTS ARRAYS KPN AND Q INTO KWDS AND RN
26000	
26100		DO 18 K=1,JPQ
26200	18	Q(K)=0
26300	C ZERO IT FOR FUTURE SAFETY
26400	
26500		JCUE=0
26600		RLFT=10000
26700	811	DO 577 K=1,ITEM
26800		R=CODEN(KWDS,K,RN,J)
26900		IF(R.GT.2)GO TO 809
27000		IF(RLFT.GT.RN(J+3))RLFT=RN(J+3)
27100	C RLFT IS LEFT-MOST NOTE OR REST.  USED FOR DISCARDING ENTERING SLURS.
27200		GO TO 577
27300	809	IF(R.LT.4)GO TO 577
27400		RWD=RN(J)
27500	C RWD IS WDCNT OF EACH ITEM
27600		JS=RN(J+2)
27700		IF(IPG.LT.0)GO TO 111
27800	C IPG=-1 = EXTRACTING PARTS, =0  = PAGE LAYOUT.
27900		IF(R.NE.8)GO TO 211
28000		STFNM(JS)=0
28100		IF(RWD.GE.7)STFNM(JS)=RN(J+9)
28200	C SAVES STAFF IDENT. NAME
28300	1811	IF(ENDLN.NE.0)GO TO 577
28400		JPG=JPG+1
28500		LS=JS+1
28600		RSTNUM(LS)=JS
28700		RHGT(LS)=0
28800	 	IF(RWD.GE.2)RHGT(LS)=RN(J+4)
28900		RPSZ(LS)=RSTFAC(JS)
29000		IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(LS)
29100		IF(R5.EQ.0)SPCNT=SPCPG*RPSZ(LS)
29200	211	IF(R.NE.4)GO TO 577
29300		IF(RN(J+3).LT.RLFT)GO TO 311
29400	CC	IF(RN(J+3).LT.ZLFT)GO TO 311
29500	C ASSUMES NOTE OR REST HAS ALREADY BEEN SEEN. (ZLFT=P3+.5)
29600		IF(RN(J+2).NE.0)RN(J+1)=44
29700	CC	IF(RN(J+2).EQ.0)GO TO 577
29800	CC511	RN(J+1)=44
29900	C  BARS NOT ON STAFF ZERO NOW HAVE CODE NUM. 44
30000		GO TO 577
30100	311	IF(IPG.LT.0)GO TO 577
30200		IF(ENDLN.NE.0)GO TO 577
30300		IF(RWD.GE.5)BRACK(JS)=RN(J+7)+RN(J+4)*100.
30400	C  SAVE 'BRACKET' INFO (P7=3,4 OR 5) - CAN FIND WRONG THING!!
30500		GO TO 577
30600	
30700	111	IF(R.NE.8)GO TO 112
30800		IF(RWD.LT.7)GO TO 577
30900	C  NO NAME ON THIS STAFF - SO JUMP
31000		IF(RN(J+7).NE.0)GO TO 577
31100	C  SKIPS INVISIBLE STAVES.
31200		XLFT=RN(J+3) 
31300	C LEFT LIMIT OF STAFF
31400		R9=RN(J+9)
31500		IF(NTYPE.LT.0)TYPE 86,R9
31600		IF(R9.EQ.RNAM)GO TO 977
31700		IF(RNAM2.EQ.R9)GO TO 977
31800		IF(RNAM3.EQ.R9)GO TO 977
31900		IF(RNAM4.NE.R9)GO TO 577
32000	977	TYPE 1577,R9,NAME
32100		IF(SN.NE.200.)PAUSE ' **** SAME NAME FOUND AGAIN ****'
32200		I=JS+RSTAFF
32300		SN=I
32400		SNMTR=SN
32500		IFOUND=-1
32600	C FLAG TO SAVE RN AND KWDS ARRAYS
32700		RPSZ(1)=RSTFAC(JS)
32800		IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(1)
32900	C  SO IT WON'T LOOK ON MORE STAVES IN OTHER FILES.
33000	CZ	IF(NXX.GT.1)NXX=-NXX
33100	C THIS TAKEN OUT 3/7/80 BECAUSE DIDN'T FIND WORDS IN LOWER FILES.
33200		JCUE=-1
33300	CCC	IF(IPG.LT.0)TYPE 1577,R9,NAME
33400	C WE ONLY GET WHEN EXTRACTING PARTS.
33500		GO TO 577
33600	1577	FORMAT(1XA5,' FOUND IN ',A5)
33700	CXXX	GO TO 477
33800	112	IF(IPG.GE.0)GO TO 577
33900		IF(R.NE.16)GO TO 113
34000		IF(RN(J+5).LT.100)GO TO 577
34100		GO TO 1113
34200	113	IF(R.NE.10)GO TO 577
34300	C  SKIPS PAGE NUMS. (I.E. P7 > 2)
34400		IF(RN(J+6).LT.100)GO TO 577
34500	C SAVE NUMBER IF SIZE FACTOR(R6) IS +100 (JUST LIKE CODE 16)
34600	C????******ALL THIS TO 800-1 CAN NOW BE TAKEN OUT.  USE P6+100 FOR REHRSL. #S.
34700		RN(J+4)=RNMHT
34800		RN(J+6)=RNMSZ
34900	C  THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
35000	1113	RN(J+2)=0
35100	C PARTS ARE ALWAYS ON STAFF 0
35200	CX	JS=J
35300		JJK=RWD+2+LK
35400	CX	DO 1112 JJJ=LK,JJK
35500	CX    	SAVES(JJJ)=RN(JS)
35600	CX1112	JS=JS+1
35700		I=JJK-LK+1
35800		CALL RLOOP(SAVES(LK),RN(J),I)
35900	C PUTS RN INTO SAVES
36000		LK=JJK+1
36100		RN(J+2)=10.
36200		LLL=LLL+1
36300		KSAVE(LLL)=LK
36400	577	CONTINUE
36500	C  DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
36600	CX	IF(JCUE)GO TO 477
36700	CCC	IF(IPG)TYPE 1577,RNAM,NAME
36800	477	I=JPQ-2
36900	C READS AND WRITES 1 EXTRA WORD
37000		IF(IPG.EQ.0)GO TO 13
37100	
37200		IF(IFOUND.GE.0)GO TO 877
37300		IFOUND=-IFOUND
37400		JTEM=ITEM+1
37500		DO 1877 K=1,JTEM
37600	1877	JWDS(K)=KWDS(K)
37700		DO 2877 K=1,KWDS(JTEM)
37800	2877	RRN(K)=RN(K)
37900	C NOW DATA FOR THIS INST. IS SAVED.
38000	
38100	CZ	IF(NXX.GT.0)GO TO 877
38200	C NEXT FOR PARTS ONLY.  TO SKIP A FILE (OR MORE)
38300	CZ	NAME=NAME-2*(NXX+1)
38400	CZ	NXX=1
38500	877	NXX=NXX-1
38600		KNM(JNM)=NAME
38700		NAME=NAME+2
38800		IF(NXX.NE.0)GO TO 277
38900		JRD=JRD+1
39000		NXX=NRD(JRD)
39100		IF(NXX.NE.0)GO TO 44
39200		JNM=JNM+1
39300		NAMZ=KNM(JNM)
39400		KNM(JNM)=NAMZ-2
39500	C KNM GETS BACK +2 AT RETURN FROM RESPC.
39600		JRD=JRD+1
39700		NXX=NRD(JRD)
39800	CZ	NAME=0
39900	CZ	NAMZ=0
40000	44	RSTAFF=0
40100	13	YN=0
40200		IF(SN.NE.200)GO TO 8
40300		YN=-1
40400		IF(YCLEF.GT.1)YCLEF=-1
40500		IF(YSIG.GT.1)YSIG=-1
40600		IF(YMTR.GT.1)YMTR=-1
40700	
40800	8	ZLFT=XLFT+.5
40900		RNUM=PGNUM
41000	C  SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
41100		QLFT=RLFT
41200	C SAVE IN QLFT FOR 1ST BAR OF LINE CHECK.
41300		RLFT=RLFT-3
41400	C TO CATCH 1ST SLURS.
41500		JCUE=0
41600	
41700	C****	IF(LK.EQ.1)GO TO 2112
41800		IF(LK.EQ.1)GO TO 2113
41900	CX	DO 3112 K=1,LK    
42000	CX3112	Q(K)=SAVES(K)
42100		CALL RLOOP(Q,SAVES,LK)
42200	C PUTS SAVED THINGS INTO Q ARRAY AND POINTER ARRAY (KPN)
42300	CX	DO 4112 K=2,LLL
42400	CX4112	KPN(K)=KSAVE(K)
42500		CALL RLOOP(KPN,KSAVE,LLL)
42600		KPN(1)=1
42700	2113	IF(IPG.EQ.0)GO TO 2112
42800		IF(IFOUND.EQ.0)GO TO 2112
42900		IFOUND=0
43000		DO 183 K=1,JTEM
43100	183	KWDS(K)=JWDS(K)
43200		DO 283 K=1,KWDS(JTEM)
43300	283	RN(K)=RRN(K)
43400		ITEM=JTEM-1
43500	C NOW GOT BACK DATA FOR SINGLE INST.
43600	
43700	C THIS SECTION COLLECTS ALL ITEMS TO USED LATER(NOT EVERYTHING IF 'PARTS')
43800	2112	DO 6 K=1,ITEM
43900		R5=-1
44000		R=CODEN(KWDS,K,RN,J)
44100		IF(R.EQ.0)GO TO 6
44200	C  DUPLICATE BARS WERE CHANGED TO CODE 0
44300		RWD=RN(J)
44400	C RWD IS WDCNT OF EACH ITEM
44500	800	IF(R.NE.4)GO TO 80
44600		IF(RN(J+4).GE.1000)GO TO 801
44700	C FINDS DBL BARS OF ALL SORTS
44800		IF(RWD.GT.2)GO TO 182
44900	C  FOUND A BAR LINE
45000	CC801	IF(RN(J+3).LT.ZLFT)GO TO 6
45100	801	IF(RN(J+3).LT.QLFT)GO TO 6
45200	CC801	IF(RN(J+3).LT.RLFT)GO TO 6
45300	C DROPS BAR LINE TO LEFT OF FIRST NOTE OR REST.
45400		IF(IPG.EQ.0)GO TO 382 
45500		IF(RWD.LT.2)GO TO 382
45600		LL=RN(J+4)/100.
45700		RR=100*LL+1.0
45800		RN(J+4)=RR
45900	C THIS PRESERVES DOUBLE BARS OF ALL SORTS.
46000	CCC	IF(RN(J+2).NE.0)GO TO 182
46100	C  KEEP BAR LINES ON STAVES >0 BUT DON'T COUNT THEM.
46200	382	CALL DBAR(K,ITEM,J)
46300		IF(YN.EQ.0)GO TO 810
46400		CALL ADRST(KPN,RR)
46500		GO TO 6
46600	182	RN(J+1)=44
46700	C  CHANGES CODE NUM 
46800		IF(IPG.EQ.0)GO TO 482
46900		IF(RN(J+5).EQ.150)RN(J+2)=SN
47000	C P5=150=PUT CRESC-DECRESC. IN ALL PARTS (WHEN IN PARTS MODE [IPG=-1])
47100	482	IF(RWD.LT.5)GO TO 80
47200		IF(RN(J+7).GE.3)GO TO 6
47300	C  SKIP HEAVY BRACKETS.
47400		IF(RWD.LT.4)GO TO 80
47500		A=RN(J+6)
47600		IF(A.EQ.0)GO TO 80
47700		IF(A.GE.199)RN(J+6)=200
47800	
47900	80	IF(R.NE.16)GO TO 180
48000		IF(RWD.LT.8)GO TO 180
48010	C3/81	IF(RWD.LT.8)GO TO 280
48100		IF(RN(J+10).EQ.1)RN(J+3)=RN(KWDS(K-1)+3)
48200	C PUT CONTINUATION OF TEXT IN SAME POS. AS 1ST UNIT OF TEXT.
48300	C3/81 280	IF(IPG.EQ.0)GO TO 180
48400	C3/81	IF(RN(J+5).GE.100)RN(J+2)=SN
48450	C3/81**** WANTED TEXT ALREADY SAVED IN 'SAVE' ARRAY ****
48500	C CATCHES WANTED TEXT ON OTHER LINES.  (P5>100)
48600	CXXX 	IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
48700	C  LIMITS SIZE OF LETTERS.  ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
48800	
48900	180	RSN=RN(J+2)
49000		IF(IPG.LT.0)GO TO 2011
49100		ISN=RSN
49200		RSN=SN
49300	C  THE STAFF NUM.
49400	
49500	2011	IF(R.NE.3)GO TO 3801
49600		IF(IPG.LT.0)GO TO 2111
49700		CLEF=RCL(ISN)
49800		GO TO 4801
49900	2111	IF(RN(J+6).LT.100)GO TO 4804
50000		RN(J+2)=SN
50100	C SIZE +100 (R6) IS PUT IN ALL PARTS (FOR P,PP,PPP,MF, ETC.)
50200		GO TO 4803
50300	4804	IF(YCLEF)GO TO 4801
50400		IF(RSN.NE.SN)GO TO 6
50500	4801	RR=CLEFN(RN,J)
50600	C  GET CLEF NUMBER.
50700		IF(RR.EQ.CLEF)GO TO 6
50800	C SKIP DUPLICATE CLEFS.
50900		IF(RR.GT.4)GO TO 4800
51000	C 0=TREB 1=BASS 2=ALTO 3=TENOR 4=PERCUSSION CLEF.
51100		IF(IPG.LT.0)GO TO 17
51200		RCL(ISN)=RR
51300		IF(RCLEF(ISN).EQ.99)RCLEF(ISN)=RR
51400	C  SAVE FIRST CLEF ON EACH STAFF
51500		GO TO 1800
51600	CP16	FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
51700	CP	TYPE 16,RR
51800	CP	ACCEPT 5,RR
51900	17 	R5=RR
52000		CLEF=RR
52100		YCLEF=0
52200		GO TO 1800
52300	4800	IF(RSN.NE.SN)GO TO 6
52400	4803	RN(J+1)=33
52500		GO TO 1800
52600	4802	YCLEF=0
52700	C  CATCHES CLEF AFTER FIRST RESTS.
52800		GO TO 6
52900	
53000	3801	IF(R.NE.17)GO TO 3800
53100		RR=RN(J+5)
53200		IF(IPG.GE.0)GO TO 3803
53300		IF(RSN.NE.SN)GO TO 6
53400	C FOR PARTS:  SKIP IF NOT ON RIGHT STAFF.
53500		IF(QSIG.EQ.RR)GO TO 6
53600	C FOR PARTS:  IF SAME KEY SIG. THEN OMIT IT.
53700		QSIG=RR
53800		GO TO 3804
53900	3803	IF(RR.EQ.RSIG(ISN))GO TO 6
54000	C SKIPS DUPL. KEY SIGS. 
54100	C***** WHAT ABOUT CHANGING KEY SIGS?????
54200		RSIG(ISN)=RR
54300		GO TO 1800
54400	C****10/2/80**** ABOVE 2 FOR CHANGING KEY SIG. ( I HOPE!)
54500	CC	YSIG=0
54600	3804	IF(RSIG(ISN).EQ.99)RSIG(ISN)=RR
54700	C SETS UP KSIG ONCE ONLY.
54800		GO TO 1800
54900	
55000	3800	IF(R.EQ.8)GO TO 6
55100	C  OMIT ALL STAVES FOR NOW
55200		IF(R.NE.18.)GO TO 81
55300	CP	IF(IPG)GO TO 2311
55400		XMTR=RMETER(ISN)
55500		GO TO 1801
55600	2311	IF(YMTR)GO TO 1801
55700		IF(SNMTR.EQ.200.)SNMTR=RSN
55800	C  SO IT WON'T REPEAT METERS.
55900	C  CHECK ALL METERS IF LINE HAS NOT THIS INST.
56000		IF(RSN.NE.SNMTR)GO TO 6
56100	1801	RA=TSIG(RN,J)
56200	C  THE TIME SIG.
56300		IF(XMTR.EQ.RA)GO TO 6
56400		XSIG=RA
56500		XMTR=RA
56600		YMTR=0
56700		IF(IPG.LT.0)GO TO 181
56800		RMETER(ISN)=RA
56900		GO TO 1800
57000	181	RR=RN(J+3)
57100		DO 281 LS=1,LLL-1
57200		IF(CODEN(KPN,LS,Q,KW).NE.R)GO TO 281
57300	C LOOK FOR SAME  METER CLOSE TO  SAME POS. (DIF. METER WILL OVERPRINT)
57400		IF(XSIG.NE.TSIG(Q,KW))GO TO 281
57500		IF(ABS(Q(KW+3)-RR).LT.0.5)GO TO 6
57600	281	CONTINUE
57700		GO TO 1800
57800	
57900	81	IF(RSN.NE.SN)GO TO 6
58000	1800	IF(IPG.EQ.0)GO TO 5800
58100		IF(RN(J+3).LT.XLFT)GO TO 6
58200	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
58300		GO TO 6800
58400	5800	IF(R.NE.7)GO TO 282
58500	6800	IF(R.LT.4)GO TO 810
58600		IF(R.EQ.44)GO TO 6801
58700		IF(R.GT.7)GO TO 810
58800	C  NEXT FOR ITEMS WHERE P6 MAY GO PAST 200.
58900		IF(RWD.LT.5)GO TO 810
59000	6801	A=ABS(RN(J+7))
59100		IF(A.LT.2.OR.A.GT.7)GO TO 82
59200	C  CATCHES TRILL WIGGLE OVER END OF LINE.
59300	282	IF(R.NE.5)GO TO 810
59400		IF(RN(J+3).LT.RLFT)GO TO 6
59500	C OMIT ENTERING SLURS.   NEXT CHECKS FOR SLUR OVER END OF LINE
59600	82	IF(RN(J+6).GE.199.)RN(J+6)=200.
59700	C  ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
59800	810	KL=0
59900	CC	IF(R.GT.2)GO TO 1810
60000		IF(R.EQ.1)GO TO 2810
60100		IF(R.NE.2)GO TO 1810
60200		IF(IPG.GE.0)GO TO 2810
60300		IF(RWD.LT.8)GO TO 2810
60400	C NEXT FOR FINDING CUES WHEN IN PARTS MODE.  FINALLY GETS LAST NEEDED POINTER.
60500		IF(RN(J+10).GE.0)JCUE=K
60600	C NEXTS FINDS NOTES AND RESTS WITHOUT RHYTHM (P7 OR P9)
60700	2810	IF(RN(J+3)-PQ.GT.SPCPG)GO TO 1810
60800	C  JUMP IF NOT IN SAME VERT. POS.
60900		IF(RT.NE.R)GO TO 1810
61000	C JUMP IF PREVIOUS ITEM WASN'T THE SAME
61100	CC	IF(RN(J+9).NE.4.0/88.0)GO TO 3810
61200	C JUMP IF NOT A GRACE NOTE
61300	CC	R=0
61400	C R=0 SO THAT GRACE NOTE WILL NEVER BE TOO CLOSE TO REG. NOTE.
61500	CC	GO TO 1810
61600	3810	RS=9-R*2
61700		IF(RWD.GE.RS)GO TO 1810
61800	C JUMP IF WDCNT IS BIG ENOUGH
61900		KL=RS-RWD
62000	C  SEND THE DIFFERENCE TO THE SUBROUTINE AND ADD A RHYTHM (1.0)
62100	1810	IF(IPG.LT.0)RN(J+2)=0
62200	C  ALWAYS SET STAFF NUM TO 0 FOR PARTS.
62300		CALL QRN(J,KPN,K)
62400	C  PUTS NEEDED THINGS INTO Q ARRAY
62500		RT=R
62600		PQ=RN(J+3)
62700	C SAVE THINGS FOR NEXT TIME AROUND LOOP.
62800	6	CONTINUE
62900	
63000		IF(JCUE.NE.0)CALL CUES
63100	
63200	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
63300		CALL SORT(KPN)
63400	C   SORTS Q ARRAY, PUTS IT BACK INTO RN
63500	23	LL=0
63600	C  TO 'MOVE' INSTEAD OF 'JUSTIFY'
63700	CC	J=1
63800	CC223	R=CODEN(KWDS,J,RN,K)
63900	CC	IF(R.LE.3.OR.R.EQ.17.OR.R.EQ.18)GO TO 123
64000	CC	J=J+1
64100	CC	GO TO 223
64200	CC123	R8=ENDLN-RN(K+3)+2
64300	CC	R4=0
64400	CC	R7=0
64500	CC	RS=0
64600	CC	R9=0
64700	CC	R5=10000
64800	C  INSERT??  →→ IF(R8.GT.0)R9=200.
64900	CC33	CALL PTMOVE(RN,KWDS)
65000	C******* IS KQ SUPPOSED TO BE 0!!!!!!!!?????
65100		CALL SHFT0(KQ)
65200	20	CALL RESPC
65300		KNM(JNM)=KNM(JNM)+2
65400	C UPDATE THE FILE NAME
65500		GO TO 1344
65600		END
65700	
65800	C************** REREAD DOES NOT WORK - SO FOLLOWING IS REPLACED BELOW.
65900	CXX	SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
66000	CXX	COMMON /PTR/INP(72)
66100	CXX	DIMENSION FORM2(5),FORMT(5),NUMS(30)
66200	CXX	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
66300	CXX	1, FORM3/'30I)'/
66400	CXX1	FORMAT(72A1)
66500	CXXCC	IEXT='MS'
66600	CXXCC	ACCEPT 1,INP
66700	CXX	KEND=0
66800	CXXC IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
66900	CXX	READ(IDEV,1,END=12)INP
67000	CXX	DO 2 K=2,72
67100	CXX	IF(INP(K).EQ.' ')GO TO 3
67200	CXX2	IF(INP(K).EQ.'.')GO TO 4
67300	CXX3	FORMT(3)=FORM3
67400	CXX	FORMT(4)=' '
67500	CXX	FORMT(5)=' '
67600	CXX5	FORMT(2)=FORM2(K-1)
67700	CXX	REREAD FORMT,NAME,NUMS
67800	CXX	GO TO 10
67900	CXX4	FORMT(3)=FORM2(1)
68000	CXXC  CATCHES DOT
68100	CXX	DO 7 N=K+1,72
68200	CXX7	IF(INP(N).EQ.' ')GO TO 8
68300	CXX8	FORMT(4)=FORM2(N-K-1)
68400	CXX	FORMT(5)=FORM3
68500	CXX	FORMT(2)=FORM2(K-1)
68600	CXX	REREAD FORMT,NAME,K,IEXT,NUMS
68700	CXX	CALL LO2UP(IEXT)
68800	CXX10	CALL LO2UP(NAME)
68900	CXX	RETURN
69000	CXX12	KEND=-1
69100	CXX	END
69200	
69300		SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
69400		DIMENSION NUMS(1),RI(30)
69500		COMMON /PTR/INP(72) /JWDS/JWDS(1)
69600		EQUIVALENCE(INP,RI)
69700	100	FORMAT(A5,73A1)
69800		KEND=0
69900	C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
70000		READ(IDEV,100,END=12)NAME,K,INP
70100		IF(K.EQ.' ')GO TO 2 
70200		IF(K.NE.'.')GO TO 8
70300	C NOW FOUND EXTENSION.  GO PACK IT.
70400		DO 4 K=2,5
70500	4	NUMS(K)=' '
70600		DO 5 K=1,5          
70700		IF(INP(K).EQ.' ')GO TO 6         
70800	5	NUMS(K)=INP(K)
70900	6	CALL PACKX(IEXT,NUMS)
71000		CALL LO2UP(IEXT)
71100		GO TO 11
71200	2	K=1
71300	11	CALL ASCNUM(INP(K),RI,JWDS,M)
71400	C ASCNUM CHANGES ASCII TO NUMBERS, JWDS IS A DUMMY FOR NOW, M=HOW MANY
71500		DO 7 K=1,M
71600	7	NUMS(K)=RI(K)
71700	10	CALL LO2UP(NAME)
71800		RETURN
71900	8	TYPE 9
72000	9	FORMAT(' **** USE ONLY 5-LETTER NAMES.  ONLY 1 EXT. CAN BE USED')
72100		STOP
72200	12	KEND=-1
72300		END
72400	
72500		SUBROUTINE PACKX(NAM,KNM)
72600		DIMENSION KNM(5)
72700		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
72800		1 , MM/"774000000000/
72900		NAM=0
73000		DO 12 K=5,1,-1
73100		NAM=NAM .OR. (KNM(K) .AND. MM)
73200		IF (K.EQ.1)RETURN
73300	17	IF (NAM.GE.0)GO TO 13
73400		NAM = (( NAM .AND. LL)/KK) .OR. JJ
73500		GO TO 12
73600	13	NAM = NAM / KK
73700	12	CONTINUE
73800		END
73900	
74000		SUBROUTINE ASCNUM(I,RI,KNT,M)
74100	      DIMENSION KNT(72),RI(72),I(72)
74200	      INTEGER ZERO,NINE,KNT,J,I,DOT,BLA
74300	CC      INTEGER*1 ZERO,NINE,KNT,J,I,DOT,BLA
74400	      DATA DOT/'.'/,BLA/' '/,ZERO/'0'/,NINE/'9'/
74500	      DO 10 K=1,72
74600	10    KNT(K)=-1
74700	      IDEC=0
74800	      M=1
74900	      C=1.0
75000	      R=0
75100	      DO 5 K=1,72
75200	      J=I(K)
75300	      IF(J.EQ.BLA)GO TO 8
75400	      IF(J.NE.DOT)GO TO 6
75500	      IDEC=-1
75600	      GO TO 5
75700	6     IF(J.GE.ZERO.AND.J.LE.NINE)GO TO 7
75800	      CALL STOW(J,RI(M))
75900	      KNT(M)=0
76000	      GO TO 9
76100	7     IF(IDEC.NE.0)C=C*0.1
76200	      CALL CONV(R,J)
76300	      GO TO 5
76400	8     IF(R.EQ.0)GO TO 5
76500	      A=R*C
76600	      RI(M)=A
76700	      KNT(M)=1
76800	      R=0
76900	      C=1.0
77000		IDEC=0
77100	9     M=M+1
77200	5       CONTINUE
77300	      M=M-1
77400	        END
77500	 
77600	      SUBROUTINE CONV(R,J)
77700	CC      INTEGER*1 J
77800	CC      R=R*10.+J-48
77900		L=(J-'0')/536870912
78000		R=R*10.+L
78100	      END
78200	 
78300	      SUBROUTINE STOW(R,RI)
78400	      RI=R
78500	      END
78600	 
78700	      SUBROUTINE ASC(R)
78800	200   FORMAT(' ',A1)
78900	      WRITE(5,200)R
79000	      END
79100	      SUBROUTINE RNUM(R)
79200	201   FORMAT(F13.4)
79300	      WRITE(5,201)R
79400	      END
79500	
79600		SUBROUTINE LO2UP(J)
79700	C CONVERTS ALL LOWER CASE TO UPPER CASE.
79800		J=J.AND..NOT.((J/2).AND."201004020100)
79900		END
80000	
80100		FUNCTION TSIG(Q,J)
80200		DIMENSION Q(1)
80300		TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
80400	C COMBINES METER NUMS.  (2/4 = 204. ETC.)
80500		END